HPAVC/HPAVC CD-ROM.iso/pc/ALIAS.ZIP/ALIASPAS.PAS

Pascal/Delphi Source File | 1996-03-26 | 11.0 KB | 586 lines

Program AntiAliasPrototyper;
{
  This is an scaling/rotation/antialiasing prototyping program
  by Lewis A. Sellers, ie Minimalist of The Minimalist Group
  (http://www.1stresource.com/l/lsellers/),
  and the MOSOCI Grail Project (http://www.dwc.edu/grail).

  Written 1995-1996 A.D.

  You can use it and the code involved if you wish as long as
  you include the standard greetings to me somewhere in your
  program, say in the credits.

  It was originally a Turbo Borland C/ASM DOS 16-bit program,
  but I recoded it into Pascal 7.0.
  My first pascal program ever on the IBM platform actually. :-)
  Frankly, it is a lot cleaner looking than the original. Hmmm...

  The Keys:
    '1' is no antialiasing.
    '2' is bilinear.
    '3' is trilinear.
    '4' is... something I was playing with.
  The left/right arrows change rotation.
  The - + [ and ] keys zoom.
  Press any key to stop zooming.
  ESC and Space stop the program.

  You must supply a BMP filename as an argument such as:
  C:> ALIAS DEATH.BMP

  The BMP it uses must be a 320x200 256 color grayscale image.

  This is by no means fast. If I want something fast I do it in pure
  assembly.

  GREETS:
  Thanks to __Elendil and Lumpy (and Hugh and Bimba) for the impromptu
  Pascal hints. :)

  And JMX/Opiate for the incentive to learn pascal.
}


{$R-}
{$X+} { use FPU }
{$M 16384,196608,196608} {probably too much... but tired of crashes while experimenting }

USES
   Crt, DOS;

const
    {screen constants}
    WIDTH = 320;
    HEIGHT = 200;
    SCREENSIZE = WIDTH*HEIGHT;
    PALETTESIZE = 256*3;
    VGA : Word = $a000;
    FAILURE = 0;
    SUCCESS = 1;
    PI = 3.14159;

type
    pScreen = ^pScreenType;
    pScreenType = array[0..SCREENSIZE] of byte;

VAR
    texture : pScreen;
    composite :pScreen;
    y320 : array[0..HEIGHT] of word;


{ switch to 320x200 256 straight VGA }
Procedure SetGraphicsMode; assembler;
Asm
    mov ax,13h
    int 10h
    mov dx,3c2h
    mov al,0e3h
    out dx,al
End;


{ back to 80x25 text mode }
Procedure SetTextMode; assembler;
Asm
    mov ax,03h
    int 10h
End;


{ load the 320x200 grayscale bitmap into memory }
Function LoadImage(filename : string) : byte;
type
    pPalette = ^PaletteType;
    PaletteType = array[0..PALETTESIZE] of byte;

Var
    pFileMem : pScreen;
    FileHandle : file;
    thrash : pScreen;
    palette : pPalette;
    result : word;

Begin
    Assign(FileHandle, filename);
    Reset(FileHandle, 1);
    GetMem(thrash, 320*200);
    GetMem(palette, 1024);
    Seek(FileHandle, 54);
    BlockRead(FileHandle, palette^, 1024, result);
    BlockRead(FileHandle, thrash^, 320*200, result);
    Close(FileHandle);

    { fake thrash for testing }
{    Asm
        les di, thrash
        mov cx,320*200
        sub al,al
@xyloop:
        mov es:[di],al
        inc al
        inc di
        dec cx
        cmp cx,0
        jne @xyloop
    End; }


    { MS uses funky file formats.
      Change from b-g-r-unused dword format to proper RGB 3byte and write
      it to the video card as we do so. }

    port[$3c6]:=$0ff;
    port[$3c8]:=0;
    Asm

        les si,palette
        mov cx,256
        cld
        mov dx,$3c9
@ploop:
        mov al,es:[si+2]
        shr al,2
        out dx,al

        mov al,es:[si+1]
        shr al,2
        out dx,al

        mov al,es:[si]
        shr al,2
        out dx,al

        add si,4
        dec cx
        jne @ploop
    End;


    { Thrash the dumb MS format... The image is stored uncompressed
    UPSIDE-DOWN, each line being on a 32-bit DWORD boundry. Hmm. }
    Begin
        Asm
          push ds

          cld
          mov cx, HEIGHT

          les di, texture
          lds si, thrash
          add di, (HEIGHT-1)*WIDTH
@tloop:
          push cx
          push si
          push di
          mov cx, WIDTH/2
          rep movsw
          pop di
          pop si
          pop cx

          add si, WIDTH
          sub di, WIDTH

          dec cx
          cmp cx,0
          jne @tloop

          pop ds
        End;
    End;

    FreeMem(palette, 1024);
    FreeMem(thrash, 320*200);
    LoadImage:=SUCCESS;
End;


{ This is it. This rotates and scales the image into a 200x200 window. }
Procedure FastRotate(scale, ang : Real);
VAR
    xscale,
    yscale,
    xc,
    yc : Longint;

    scanline : word;
    x, y : Integer;
    tempx, tempy : word;
    xlong, ylong : Longint;

    tseg, toff : word;
    hseg, hoff : word;
    texel : byte;

Begin
    xscale := round ( (sin(ang)*65536.0)*scale);
    yscale := round ( (cos(ang)*65536.0)*scale);
    xc := 160*65536 - (100*(yscale+xscale));
    yc := 100*65536 - (100*(yscale-xscale));
    scanline:=0;

    tseg:=seg(texture^);
    toff:=ofs(texture^);
    hseg:=seg(composite^);
    hoff:=ofs(composite^);

    for y:=0 to 199 do
    Begin
        xlong:=xc;
        ylong:=yc; { init x/ylong to topleft of square }
        for x:=60 to 60+200 do
        Begin { normally from 0 to 319 }
            tempx:=xlong SHR 16;
            tempy:=ylong SHR 16;

            if (tempx<0) OR (tempx>=WIDTH) OR (tempy<0) OR (tempy>=HEIGHT) then
            Begin
                Mem[hseg:hoff+scanline+x]:=0;
            End
            else
            Begin
                texel:=Mem[tseg:toff+y320[tempy]+tempx];
                Mem[hseg:hoff+scanline+x]:=texel;
            End;

            inc(xlong,yscale);
            dec(ylong,xscale);
        End;
        inc(scanline,WIDTH);
        inc(xc,xscale);
        inc(yc,yscale);
    End;
End;


{ The bilinear antialiasing is post rotation/scaling here.
  We perform the operation on the HOLDing texture which is then blitted
  to video memory elsewhere in the program. }
Procedure Bilinear; assembler;
Asm
        push ds
        lds di, composite
        add di, (WIDTH+1) + 60
        mov cx, 198
@yloop:
        push cx
        push di
        mov cx, (WIDTH-2) - 120
@xloop:
        sub ax,ax
        sub bx,bx
        mov al,[di-1]
        add bx,ax
        mov al,[di+1]
        add bx,ax
        mov al,[di-WIDTH]
        add bx,ax
        mov al,[di+WIDTH]
        add bx,ax

        shr bx,2

        mov al,[di]
        add bx,ax
        shr bx,1

        mov [di],bl
        inc di
        dec cx
        cmp cx,0
        jne @xloop

        pop di
        pop cx
        add di,WIDTH
        dec cx
        cmp cx,0
        jne @yloop
        pop ds
End;


{ The trilinear antialiasing is post rotation/scaling here. }
Procedure Trilinear; assembler;
Asm
        push ds
        lds di, composite
        add di, (WIDTH+1) + 60
        mov cx, (HEIGHT-2)
@yloop:
        push cx
        push di
        mov cx, (WIDTH-2) - 120
@xloop:
        mov ax,0
        mov bx,0
        mov al,[di-1]
        add bx,ax
        mov al,[di+1]
        add bx,ax
        mov al,[di-WIDTH]
        add bx,ax
        mov al,[di+WIDTH]
        add bx,ax
        mov al,[di-(WIDTH-1)]
        add bx,ax
        mov al,[di-(WIDTH-1)]
        add bx,ax
        mov al,[di+(WIDTH+1)]
        add bx,ax
        mov al,[di+(WIDTH-1)]
        add bx,ax
        shr bx,3
        mov al,[di]
        add bx,ax
        shr bx,1
        mov [di],bl
        inc di
        dec cx
        cmp cx,0
        jne @xloop
        pop di
        pop cx
        add di,WIDTH
        dec cx
        cmp cx,0
        jne @yloop
        pop ds
End;


{ The hyper-linear? antialiasing is post rotation/scaling here.
  If you're playing with antialiasing, do it here. This is the most
  interesting of effects I ran across while playing with antialiasing.
  Produces a short of fuzzy-ghosting afterimage. }
Procedure Hyperlinear; assembler;
Asm
        push ds

        lds di, composite
        add di, (WIDTH+1)+60
        mov cx, (HEIGHT-2)
@yloop:
        push cx
        push di
        mov cx, (WIDTH-1) - 60*2
@xloop:
        sub ax,ax
        sub dx,dx
        mov al,[di-1]
        add dx,ax
        mov al,[di+1]
        add dx,ax
        mov al,[di-WIDTH]
        add dx,ax
        mov al,[di+WIDTH]
        add dx,ax

        mov al,[di-(WIDTH+1)]
        add dx,ax
        mov al,[di-(WIDTH-1)]
        add dx,ax
        mov al,[di+(WIDTH+1)]
        add dx,ax
        mov al,[di+(WIDTH-1)]
        add dx,ax

        shr dx,3

        mov al,[di]
        add dx,ax
        shr dx,1

        mov [di-(WIDTH+1)],dl
        mov [di+(WIDTH+1)],dl
        mov [di-(WIDTH-1)],dl
        mov [di+(WIDTH-1)],dl

        inc di
        dec cx
        cmp cx,0
        jg @xloop

        pop di
        pop cx

        add di, WIDTH
        dec cx
        cmp cx,0
        jg @yloop
        pop ds
End;


{ copy the composition texture to the VGA screen memory. }
Procedure Copycomposite; assembler;
Asm
    push ds
    mov di, VGA
    mov es,di
    sub di,di
    lds    si,composite
    mov cx,320*200/2
    cld
    rep movsw
    pop ds
End;


{ clear the composition texture }
Procedure Clearcomposite; assembler;
Asm
    les di, composite
    mov cx,320*200/2
    sub ax,ax
    cld
    rep stosw
End;


{ the main }
VAR
    angle,
    angle_v,
    scale : Real;
    n,
    alias: Integer;
    key : Char;

Begin
    ClrScr;
    Writeln('Antialiasing Prototyper by Minimalist 1995-1996.');
    Writeln;

    if ParamCount=0 then
    Begin
        writeln('Use: ALIAS filename.bmp');
        halt(1);
    End;

    Writeln('This is the PASCAL version of the original C prototyper written the week of');
    Writeln('March 13-14th in preparation for NAID 96. It is also the very first PASCAL');
    Writeln('program I have written for the IBM PC.');
    Writeln('The BMP must be 320x200 256 grayscale.');

    Writeln;

    Writeln('You may use any of the following keys:');
    Writeln(' ESC will exit the program.');
    Writeln(' 1   no antialiasing');
    Writeln(' 2   post Bilinear antialising');
    Writeln(' 3   post Trilinear antialiasing');
    Writeln(' 4   post um... hyperlinear antialiasing? :-)');
    Writeln(' Use left/right arrows to change rotation.');
    Writeln(' Zoom with the - + [ and ] keys. Press any other to stop.');

{    Writeln;
    Writeln('=texture=');

    Writeln('memory ',MaxAvail);
}
    if MaxAvail < 64000 then
    Begin
        Writeln('Low Memory ',MaxAvail);
        Halt(1);
    End;
    GetMem(texture, 64000);
{
    Writeln('texture ',seg(texture),':',ofs(texture));
    Writeln('texture^ ',seg(texture^),':',ofs(texture^));
    Writeln('texture^ seg ',seg(texture^), ' texture^ off', ofs(texture^));


    Writeln;
    Writeln('=composite=');

    Writeln('memory ',MaxAvail);
}
    if MaxAvail < 64000 then
    Begin
        Writeln('Low Memory ',MaxAvail);
        Halt(1);
    End;
    GetMem(composite, 64000);
{
    Writeln('composite ',seg(composite),':',ofs(composite));
    Writeln('composite^ ',seg(composite^),':',ofs(composite^));
    Writeln('composite^ seg ',seg(composite^), ' composite^ off', ofs(composite^));
}

    Writeln;
    Writeln('Press any key to begin....');
    Readkey;

    for n:=0 to 199 do y320[n]:=n*320;

    SetGraphicsMode;
    if LoadImage(ParamStr(1)) = FAILURE then
    Begin
        SetTextMode;
        writeln('The file ', ParamStr(1),' does not exist.');
        halt(2);
    End;

    clearcomposite;

    angle:=PI/256;
    angle_v:=-PI/128;
    scale:=1.05;
    alias:=0;

    key:=#1;
    while key<>#27 do
    Begin
        if keyPressed then key:=ReadKey;

        case key of
               '1': alias:=1;
               '2': alias:=2;
               '3': alias:=3;
               '4': alias:=4;
               '5': alias:=5;

               '-': scale:=scale-0.05;
               '=': scale:=scale+0.05;
               '[': scale:=scale-0.5;
               ']': scale:=scale+0.5;
        End;

        if key=#0 then
        Begin
            key:=ReadKey;
            case key of
                #75: angle_v:=angle_v-PI/128;
                #77: angle_v:=angle_v+PI/128;
            End;
        End;

        Begin
            Gotoxy(1,1);
            Write('Scale:=',scale,'  ');
            Gotoxy(1,2);
            Write('Angle:=',angle,'  ');
            FastRotate(scale,angle);
            case alias of
                2: bilinear;
                3: trilinear;
                4: hyperlinear;
            End;
        End;

        copycomposite;
        angle:=angle+angle_v;
    End;

    SetTextMode;

    Writeln('By Minimalist (Lewis A. Sellers) 1996. Part of the C/Pascal/Asm package.');
    Writeln('To contact, email: [e-mail] (shortly to be [e-mail]).');
    Writeln('or drop by http://www.dwc.edu/grail, site of the Grail Operating System Project.');
    FreeMem(composite,64000);
    FreeMem(texture,64000);
End.